About Event and Cleanup

Note: DAYS = Baseline audit, monday preparty, SG day 1, and SG day 2

knitr::opts_chunk$set(warning=FALSE, message=FALSE)

####### ALL LIBRARIES USED ###########
###### DATA MANIPULATION ######
options(stringsAsFactors = FALSE)
library(dplyr) # for main data manipulations
library(reticulate) # for python script
library(reshape2) # for dcast()
library(lubridate) # for hours()
source_python("euclidean_script.py") # python script

###### GRAPHING ######
library(RColorBrewer) # for colors in graphs
library(ggplot2) # for lollipop graph
library(hrbrthemes) # for ggplot theme
library(sunburstR) # for sunburst graph
library(streamgraph) # for stream graph
library(heatmaply) # for heatmap graph
library(DT) # for data table
library(leaflet) # for leaflet map
library(htmltools) # for leaflet map
######################################


# setup to get all types
collection = c('trashCan', 'recyclingCan', 'tobaccoAshCan')
litter = c('paper', 'tobacco', 'unknown', 'plastic', 'food', 'glass')

# icon png files
icons = c("cigarette.png", "cigarette.png", "plastic-bottle.png", "cigarette.png", "cigarette.png", "cigarette.png")

# load in cleaned raw data
raw <- read.csv('clean/clean_rubbish.csv') %>% 
  mutate( # change days from shorthand to full
    day = factor(ifelse(day =="Sun", "Sunday",
                        ifelse(day =="Mon", "Monday",
                          ifelse(day == "Tue", "Tuesday", "Wednesday"))),
                 levels = c("Sunday", "Monday", "Tuesday", "Wednesday"))
  )

The breakdown of Collection Object Clustering

# clustering data points with python script
clustered_data <- raw %>% 
  subset(city == 'Redwood City') %>% # this is a different area
  get_euclidean(collection, litter) # python function

#########################
# CLUSTERING PREFORMED

# getting details on clustered data
clusters <- clustered_data %>% 
  subset(is_litter == 1) %>% # only want objects
  group_by(closest_cent, day) %>% 
  summarise(
    cent_type = max(cent_type),
    num_litter = n(),
    mean_dist = round(mean(distance),2),
    median_dist = round(median(distance),2),
    sd_dist = round(sd(distance),2),
    max_dist = round(max(distance),2),
    lat = mean(lat),
    long = mean(long)
  ) %>% 
  arrange(-num_litter)

# getting data for sunburst plot
clustered_data %>% 
  subset(is_litter == 1) %>% 
  group_by(cent_type, day, rubbishType) %>% 
  summarise(
    num_litter = n()
  ) %>% 
  mutate( # path is needed for plot
    path = paste(cent_type, rubbishType, day, sep="-")
  ) %>% 
  subset(select = c(path, num_litter)) %>% 
  # plotting suburst graph
  sunburst(legend=TRUE,
           colors = rev(brewer.pal(9, "RdPu")[4:9]),
           count = TRUE,
           breadcrumb = list(w=150,h=50, t=30),
           sumNodes = TRUE
           )

This graph does a great job of breaking down the desparities of Trash Cans and Recycling Cans, while also showing similarities!

Did the Rubbish Team have an effect?

To see if the Rubbish team had an effect on the clustering, we should look where they were focused.

get_hour <- function(time){
  # function used to save space
  return (hour(as.POSIXct(time, format="%Y-%m-%d %H:%M:%S")))
}

# getting plot data for streamgraph
plot_data <- clustered_data %>% 
  subset(is_litter==1) %>% # only want objects
  mutate( # getting hours of days, and making them concurrent
    time = ifelse(day=="Sunday", get_hour(time),
                  ifelse(day=="Monday", get_hour(time)+24,
                         ifelse(day=="Tuesday", get_hour(time)+48,
                                get_hour(time)+72))),
    # make graph prettier
    closest_cent = paste(ifelse(cent_type == "trashCan", "Trash ID:",
                                ifelse(cent_type == "recyclingCan", "Recyc ID:", "Ash ID:")),
                         ifelse(closest_cent<10, paste("0",closest_cent, sep=""), closest_cent),
                         "|   Litter Collected",
                         sep= " ")
  ) %>% 
  group_by(closest_cent,time) %>% 
  summarise(
    num_litter = n()
  ) %>% 
  arrange(-num_litter)

 
# plotting Streamgraph
plot_data %>% 
  streamgraph(
    "closest_cent", "num_litter", "time",
    interpolate="step", #offset = "zero",
    scale = "continuous", width="800px", height="400px"
            ) %>% 
  sg_legend(show=TRUE, label="Collection ID: ") %>% 
  sg_fill_manual(brewer.pal(9, "RdPu")[c(3:9)]) %>% 
  sg_annotate("Collected Litter per Hour", "300px", "400px")

This graph shows two things:

• This is a multi-day event, which means is why we see the sharp spikes leading to 0 litter being collected for some hours.

• The litter team had stayed by certain collection objects for longer than others.

Well, how close was the litter to Collection Objects?

To see this, we need compare the mean distances for each collection object. It will be better to view this for each individual day, as we know there was more foot traffic on Tuesday and Wednesday.

# prepping data for heatmap plot
plot_data <- clusters %>%
  mutate(
    closest_cent = paste(ifelse(cent_type == "trashCan", "Trash:",
                                ifelse(cent_type == "recyclingCan", "Recyc", "Ash")),
                         ifelse(closest_cent<10, paste("0",closest_cent, sep=""), closest_cent),
                         sep= " ")
  ) %>% 
  subset(select = c(day, closest_cent, mean_dist)) %>% 
  dcast(closest_cent ~ day, value.var = "mean_dist") %>% 
  mutate( # chaning na values to 0
    Sunday = ifelse(is.na(Sunday),0,Sunday),
    Monday = ifelse(is.na(Monday),0,Monday),
    Tuesday = ifelse(is.na(Tuesday),0,Tuesday),
    Wednesday = ifelse(is.na(Wednesday),0,Wednesday)
  )

# changing rownames to centroid id
rownames(plot_data) <- plot_data[,"closest_cent"]

# making dataframe into matrix
plot_data <- plot_data %>% 
  subset(select = -c(closest_cent)) %>% 
  as.matrix()

# colors for graph
colors <- brewer.pal(9, "RdPu")[c(1, 6:9)]
colors[1] <- "#ffffff"

# plotting heatmap
plot_data %>% 
  heatmaply(
          plot_method = "plotly",
          colors = colorRampPalette(colors),
          dendogram = "both",
          show_dendrogram = c(FALSE, FALSE),
          label_names = c("Day", "Collection ID", "Mean Distance"),
          grid_color = "white",
          main = "Mean Distance of Litter from the (Trash / Recyclying / Ash) Can",
          #ylab = "Collection Objects (ID)",
          xlab = "A distance of 0 means there are no objects around the Collection Object.",
          key.title = "meters",
          showticklabels = c(TRUE, TRUE),
          column_text_angle = 0,
          colorbar_len = .8,
          grid_gap = 1
          ) %>% 
  layout(width=800)

This graph shows that ||| PERCENTAGE ||| of the litter has a mean distance of under 20 meters to the closest applicable Collection Object.

What does this look like?

We have looked at all the numbers, lets try and see what this actually means in regards to real life!

colors <- colorNumeric(
  # function for color of collection types
  palette = c('#134a47', '#2859b8', 'green'),
  domain = c(1,2,3)
  )

labs <- lapply(seq(nrow(clusters)), function(i) {
  # function for mouseover of circles
  paste0( 'Collection Type: ', clusters[i, "cent_type"], '<p>Number of Litter Objects: ', 
          clusters[i, "num_litter"], '</p>Mean Distance: ', 
          round(clusters[i, "mean_dist"],2),' meters<p>Max Distance: ', 
          round(clusters[i, "max_dist"],2), ' meters</p>' ) 
})

html_legend <- "<img src='open-trash-can.png' style='width:20px;height:20px;'> Trash & Recycling<br/>

<img src='open-trash-can.png' style='width:20px;height:20px;'> Paper<br/>

<img src='cigarette.png' style='width:20px;height:20px;'> Tobacco<br/>

<img src='open-trash-can.png' style='width:20px;height:20px;'> Unknown<br/>

<img src='open-trash-can.png' style='width:20px;height:20px;'> Plastic<br/>

<img src='open-trash-can.png' style='width:20px;height:20px;'> Food<br/>

<img src='open-trash-can.png' style='width:20px;height:20px;'> Glass"

map <- clusters %>% 
  mutate(
    cent_type = ifelse(cent_type == 'trashCan', 1,
                       ifelse(cent_type == 'recyclingCan', 2, 3))
  ) %>% 
  leaflet(width = "100%") %>% 
  setView(lng = -122.2298, lat = 37.48650, zoom = 18) %>% 
  addProviderTiles(providers$CartoDB.Positron) %>% 
  addCircles(
    ~long, ~lat,
    radius = ~mean_dist,
    color = ~colors(cent_type),
    opacity = ~num_litter/357,
    label = lapply(labs, HTML),
    group = "Collections"
  ) %>% 
  addMarkers(lng = ~long, lat = ~lat,
             icon = makeIcon("open-trash-can.png", "open-trash-can.png", 15,15),
             group = "Collections"
             ) %>% 
  addLayersControl(
    overlayGroups = c("Collections", litter),
    options = layersControlOptions(collapsed = FALSE)
  ) %>% 
  addControl(html = html_legend, position = "bottomleft")



for (i in 1:length(litter)){
  map <- map %>% 
    addMarkers(data = clustered_data %>% 
                 subset(rubbishType == litter[[i]]),
               lng = ~long, lat = ~lat,
               icon = makeIcon(icons[[i]], icons[[i]], 7,7),
               group = litter[[i]]
               ) 
}

map

ffffffffffffffffffffffffffffff

map looks disgusting

hexbin?

clusters based on polygons?

• python script to get polygons?